home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
cowboy
/
shootout.frm
(
.txt
)
< prev
next >
Wrap
Visual Basic Form
|
1995-09-07
|
14KB
|
388 lines
VERSION 4.00
Begin VB.Form frmShootOut
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Caption = "Shoot-Out"
ClientHeight = 5400
ClientLeft = 1620
ClientTop = 1755
ClientWidth = 6135
BeginProperty Font
name = "MS Sans Serif"
charset = 0
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 5805
Icon = "SHOOTOUT.frx":0000
KeyPreview = -1 'True
Left = 1560
LinkTopic = "Form2"
ScaleHeight = 5400
ScaleWidth = 6135
Top = 1410
Width = 6255
Begin VB.Timer tmrMouseCntl
Interval = 22
Left = 1380
Top = 3780
End
Begin VB.CommandButton btnStart
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "&Start"
Height = 375
Left = 2580
TabIndex = 1
Top = 3840
Width = 1095
End
Begin VB.Timer Timer1
Left = 900
Top = 3780
End
Begin VB.PictureBox picDesert
Appearance = 0 'Flat
BackColor = &H00C0FFC0&
ForeColor = &H80000008&
Height = 3315
Left = 180
ScaleHeight = 3285
ScaleWidth = 5745
TabIndex = 0
Top = 360
Width = 5775
Begin VB.Image imgRBullet
Appearance = 0 'Flat
Height = 480
Index = 0
Left = 5100
Picture = "SHOOTOUT.frx":030A
Top = 1440
Visible = 0 'False
Width = 480
End
Begin VB.Image imgLBullet
Appearance = 0 'Flat
Height = 480
Index = 0
Left = 420
Picture = "SHOOTOUT.frx":0614
Top = 1440
Visible = 0 'False
Width = 480
End
Begin VB.Image imgCactus
Appearance = 0 'Flat
Height = 480
Index = 1
Left = 2880
Picture = "SHOOTOUT.frx":091E
Top = 2160
Width = 480
End
Begin VB.Image imgCactus
Appearance = 0 'Flat
Height = 480
Index = 0
Left = 2160
Picture = "SHOOTOUT.frx":0C28
Top = 480
Width = 480
End
Begin VB.Image imgPlayer
Appearance = 0 'Flat
Height = 480
Index = 1
Left = 4920
Picture = "SHOOTOUT.frx":0F32
Top = 300
Width = 480
End
Begin VB.Image imgPlayer
Appearance = 0 'Flat
Height = 480
Index = 0
Left = 360
Picture = "SHOOTOUT.frx":123C
Top = 2280
Width = 480
End
End
Begin VB.Label Label4
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Player 2 uses the mouse: left button and right button clicks move player, and left mouse double-click fires gun."
ForeColor = &H80000008&
Height = 495
Left = 180
TabIndex = 5
Top = 4860
Width = 5775
End
Begin VB.Label Label3
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Player 1 uses the keyboard: up and down arrow keys move player, and space bar fires gun."
ForeColor = &H80000008&
Height = 495
Left = 180
TabIndex = 4
Top = 4380
Width = 5835
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Player 2"
ForeColor = &H80000008&
Height = 195
Left = 4680
TabIndex = 3
Top = 120
Width = 1215
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Player 1"
ForeColor = &H80000008&
Height = 195
Left = 180
TabIndex = 2
Top = 120
Width = 1215
End
Begin VB.Image imgRIP
Appearance = 0 'Flat
Height = 480
Left = 180
Picture = "SHOOTOUT.frx":1546
Top = 3780
Visible = 0 'False
Width = 480
End
Attribute VB_Name = "frmShootOut"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
'----------------------------------------------------------
' SHOOTOUT.FRM
'----------------------------------------------------------
' KeyCodes for keyboard action.
Const KEY_SPACE = &H20
Const KEY_UP = &H26
Const KEY_DOWN = &H28
' Number of Twips to move player on each key or mouse event.
Const PlayerIncrement = 45
' Constants for mouse action.
Const NO_BUTTON = 0
Const LBUTTON = 1
Const RBUTTON = 2
' Boolean that indicates if mouse button has been pressed down.
Dim MouseButtonDown As Integer
' Number of bullets either player can have in use at one time.
Const NUM_BULLETS = 6
' Booleans indicating if player 0 or player 1 have just fired.
Dim GunFired(0 To 1) As Integer
Private Sub btnStart_Click()
'----------------------------------------------------------
' Start the game by enabling the main timer and hiding
' the start button.
'----------------------------------------------------------
Timer1.Enabled = True
btnStart.Visible = False
End Sub
Private Function Collided(imgA As Image, imgB As Image) As Integer
'--------------------------------------------------
' Check if the two Images intersect, using the
' IntersectRect API call.
'--------------------------------------------------
Dim A As tRect
Dim B As tRect
Dim ResultRect As tRect
' Copy information into tRect structure
A.Left = imgA.Left
A.Top = imgA.Top
B.Left = imgB.Left
B.Top = imgB.Top
' Calculate the right and bottoms of rectangles needed by the API call.
A.Right = A.Left + imgA.Width - 1
A.Bottom = A.Top + imgA.Height - 1
B.Right = B.Left + imgB.Width - 1
B.Bottom = B.Top + imgB.Height - 1
' IntersectRect will only return 0 (false) if the
' two rectangles do NOT intersect.
Collided = IntersectRect(ResultRect, A, B)
End Function
Private Sub Form_DblClick()
'----------------------------------------------------------
' Double-clicking the mouse fires Player 1's gun.
'----------------------------------------------------------
Dim rc As Integer
If Not Timer1.Enabled Then Exit Sub
GunFired(1) = True
rc = sndPlaySound(App.Path & "\BANG.WAV", SND_ASYNC)
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'----------------------------------------------------------
' This event handles Player 0's game action via the
' keyboard.
'----------------------------------------------------------
Dim rc As Integer
Static InKeyDown As Integer
If Not Timer1.Enabl